home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
dbase
/
lib19.zip
/
FIELDS.PRG
< prev
next >
Wrap
Text File
|
1992-09-11
|
14KB
|
393 lines
*-------------------------------------------------------------------------------
*-- Program...: FIELDS.PRG
*-- Programmer: Ken Mayer (KENMAYER)
*-- Date......: 06/25/1992
*-- Notes.....: These field processing routines were deemed as not as commonly
*-- used (at least in my own Applications), and relegated to a
*-- library file. See: README.TXT about how to use this library
*-- file.
*-------------------------------------------------------------------------------
FUNCTION MemoPagr
*-------------------------------------------------------------------------------
*-- Programmer..: Martin Leon (HMAN - ATBBS/Borland BBS)
*-- Date........: 10/28/91
*-- Notes.......: Used to display a memo on screen, allowing user to scroll
*-- memo at will.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: None
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: ?MemoPagr(<cMemo>,<ULRow>,<ULCol>,<BRRow>,<BRCol>)
*-- Example.....: ?MemoPagr(MoreData,10,20,20,65)
*-- Returns.....: .F.
*-- Parameters..: cMemo = name of memo field
*-- nULRow = upper left row position
*-- nULCol = upper left column position
*-- nBRRow = bottom right row position
*-- nBRCol = bottom right column position
*-------------------------------------------------------------------------------
PARAMETER cMemo, nULRow, nULCol, nBRRow, nBRCol
private cCursor, nEsc, nPgDn, nPgUp, nUp, nDn, nNumLines,nLines,nKey
private nAtLine,nAtRow
*-- set environment
set memowidth to nBRCol - nULCol - 1
cCursor = set( "CURSOR" )
set cursor off
*-- define a few keys
nEsc = 27
nPgDn = 3
nPgUp = 18
nUp = 5
nDn = 24
*-- determine size of window
nNumLines = memlines(&cMemo)
nLines = nBRRow - nULRow - 1
*-- save the screen, so we can restore it
save screen to sTmp
@ nULRow+1, nULCol+1 clear to nBRRow+1, nBRCol+1
@ nULRow+1, nULCol+1 fill to nBRRow+1, nBRCol+1 color B/N
@ nULRow+1, nULCol+1 fill to nBRRow-1, nBRCol-1 color RG+/B
@ nULRow, nULCol to nBRRow, nBRCol double color RG+/B
*-- deal with a blank memo ...
if nNumLines = 0
@ nULRow + 1, nULCol + 1 SAY ;
"Blank Memo. Press any key to continue..." color RG+/B
nKey = inkey(0)
*-- reset the whole thing
restore screen from sTmp
release screen sTmp
set cursor &cCursor
RETURN .F.
endif
nAtLine = 1
nAtRow = 1
do while nAtLine <= nNumLines
*-- Show one window full
do while nAtRow <= nLines .and. nAtLine <= nNumLines
@ nULRow+nAtRow, nULCol + 1 say ;
mline( &cMemo, nAtLine ) color RG+/B
nAtLine = nAtLine + 1
nAtRow = nAtRow + 1
enddo
*-- If at last line of memo...
if nAtLine > nNumLines
*-- If memo is shorter than one page, put box character in
*-- bottom left corner of box, otherwise, put an up arrow
*-- symbol there.
@ nBRRow - 1, nBRCol SAY ;
iif( nNumLines <= nLines, chr(186), chr(24)) color W+/B
do while .T.
nKey = inkey(0)
*-- If memo is shorter than one page, only allow Esc key
if nNumLines <= nLines
if nKey = nEsc
exit
endif
*-- Otherwise, allow Esc or PgUp keys
else
if nKey = nEsc .or. nKey = nPgUp .or. nKey = nUp
exit
endif
endif
?? chr(7)
enddo
if nKey = nEsc
restore screen from sTmp
release screen sTmp
set cursor &cCursor
RETURN .F.
endif
@ nULRow+1, nULCol+1 clear to nBRRow-1, nBRCol-1
@ nULRow+1, nULCol+1 fill to nBRRow-1, nBRCol-1 ;
color RG+/B
nAtLine = nAtLine - nAtRow - nLines + 1
nAtLine = iif( nAtLine < 1, 1, nAtLine )
nAtRow = 1
loop
endif
*-- Not at end of memo yet...
*-- If on first page, show down arrow only, otherwise show
*-- up/down arrow on border of box.
@ nBRRow - 1, nBRCol say ;
iif( nAtLine - nLines = 1, chr(25), chr(18)) color W+/B
do while .T.
nKey = inkey(0)
*-- If this is the first page of the memo on screen...
if nAtLine - nLines = 1
*-- Only honor PgDn, up cursor, and Esc keys
if nKey = nPgDn .or. nKey = nDn .or. nKey = nEsc
exit
endif
*-- otherwise honor PgUp and up cursor as well key as well
else
if nKey = nPgUp .or. nKey = nUp .or. nKey = nPgDn .or. ;
nKey = nDn .or. nKey = nEsc
exit
endif
endif
?? chr(7)
enddo
do case
case nKey = nEsc
restore screen from sTmp
release screen sTmp
set cursor &cCursor
RETURN .F.
case nKey = nPgUp .or. nKey = nUp
@ nULRow+1, nULCol+1 clear to nBRRow-1, nBRCol-1
@ nULRow+1, nULCol+1 fill to nBRRow-1, nBRCol-1 ;
color RG+/B
nAtLine = (nAtLine - (2 * nLines))
nAtLine = IIF( nAtLine < 1, 1, nAtLine )
nAtRow = 1
loop
case nKey = nPgDn .or. nKey = nDn
@ nULRow+1, nULCol+1 clear to nBRRow-1, nBRCol-1
@ nULRow+1, nULCol+1 fill to nBRRow-1, nBRCol-1 ;
color RG+/B
nAtRow = 1
loop
endcase
enddo
RETURN .F.
*-- EoF: MemoPagr()
PROCEDURE ScanMemo
*-------------------------------------------------------------------------------
*-- Programmer..: Martin Leon (HMAN)
*-- Date........: 02/27/1992
*-- Notes.......: This simple procedure is used to strip hard carriage returns
*-- out of all Memos in a database.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 04/15/1991 - original procedure.
*-- 02/07/1992 -- Douglas P. Saine (XRED) modified to handle
*-- passing of database name as a parameter
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Do ScanMemo with "<cDbf>"
*-- Example.....: Do ScanMemo with "TEST"
*-- Returns.....: None.
*-- Parameters..: cDbf = Name of the database to scan memos ...
*-------------------------------------------------------------------------------
parameter cDbf
private nFields, cFieldName, nLines, nLineNum
use (cDbf)
scan && search database 1 record at a time ...
nFields = 1
*-- This loop goes through all fields in the database
do while asc(field(nFields)) # 0
cFieldName = field(nFields) && save current field name
if type(cFieldName) = "M" && check to see if it's a memo
nLines = memlines(&cFieldName) && number of lines in memo
if nLines > 1 && if there's something there
delete file temp.txt && kill old file if it exists
set printer to file temp.txt && copy memo a line at a time to
nLineNum = 1 && temp file, using ??? command.
do while nLineNum <= nLines
??? mline(&cFieldName,nLineNum)
??? " "
nLineNum = nLineNum + 1
enddo
close printer
set printer to
append memo &cFieldName from temp.txt overwrite
endif && nLines > 1
endif && type(cFieldName) = "M"
nFields = nFields + 1 && go to next field ...
enddo && asc(field....
endscan && scan of database record by record ...
use && close database
RETURN
*-- EoP: ScanMemo
PROCEDURE Cut
*-------------------------------------------------------------------------------
*-- Programmer..: Michael B. Carlisle (Borland)
*-- Date........: 01/xx/1992
*-- Notes.......: This retrieves information from the field the user has
*-- currently selected and stores the information into a
*-- memory variable titled CLIPBOARD. The field itself is
*-- then cleared. CLIPBOARD should be declared public.
*-- This routine is taken from TECHNOTES.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: None
*-- Calls.......: None
*-- Called by...: Any
*-